home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / ProjectOberon / InputPO.mod < prev    next >
Text File  |  1995-07-02  |  3KB  |  112 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: InputPO.mod $
  4.   Description: Handles keyboard and mouse input for Project Oberon
  5.                modules.
  6.  
  7.    Created by: fjc (Frank Copeland)
  8.     $Revision: 1.1 $
  9.       $Author: fjc $
  10.         $Date: 1995/02/07 20:23:27 $
  11.  
  12.   Copyright © 1995, Frank Copeland.
  13.   This file is part of Oberon-A.
  14.   See Oberon-A.doc for conditions of use and distribution.
  15.  
  16.   NOTE: The module's name is InputPO instead of Input to avoid a name
  17.   clash with the Amiga Interface module of the same name.
  18.  
  19. *************************************************************************)
  20.  
  21. <* STANDARD- *>
  22.  
  23. MODULE InputPO;
  24.  
  25. IMPORT i := Intuition, as := AmigaSupport;
  26.  
  27. CONST
  28.  
  29.   N = 32;
  30.  
  31. VAR
  32.   mouseKeys : SET;
  33.   n, in, out, mouseX, mouseY, mouseW, mouseH : INTEGER;
  34.   buf : ARRAY N OF CHAR;
  35.  
  36. PROCEDURE* KeyProc ( msg : i.IntuiMessagePtr );
  37. BEGIN
  38.   IF msg.class = {i.vanillaKey} THEN
  39.     IF n < N THEN
  40.       buf[in] := CHR (msg.code); in := (in + 1) MOD N; INC (n)
  41.     END
  42.   END
  43. END KeyProc;
  44.  
  45. PROCEDURE* MouseProc ( msg : i.IntuiMessagePtr );
  46. BEGIN
  47.   IF msg.class = {i.mouseButtons} THEN
  48.     IF msg.code = i.selectDown THEN
  49.       IF (msg.qualifier * i.altLeft) # {} THEN INCL (mouseKeys, 1)
  50.       ELSE INCL (mouseKeys, 2)
  51.       END
  52.     ELSIF msg.code = i.selectUp THEN
  53.       IF (msg.qualifier * i.altLeft) # {} THEN EXCL (mouseKeys, 1)
  54.       ELSE EXCL (mouseKeys, 2)
  55.       END
  56.     ELSIF msg.code = i.middleDown THEN INCL (mouseKeys, 1)
  57.     ELSIF msg.code = i.middleUp THEN EXCL (mouseKeys, 1)
  58.     ELSIF msg.code = i.menuDown THEN INCL (mouseKeys, 0)
  59.     ELSIF msg.code = i.menuUp THEN EXCL (mouseKeys, 0)
  60.     END;
  61.     mouseX := msg.mouseX - as.win.borderLeft;
  62.     mouseY := as.win.height - as.win.borderBottom - msg.mouseY - 1;
  63.   END
  64. END MouseProc;
  65.  
  66. PROCEDURE* TickProc ( msg : i.IntuiMessagePtr );
  67. BEGIN
  68.   IF msg.class = {i.intuiTicks} THEN
  69.     mouseX := as.win.mouseX - as.win.borderLeft;
  70.     mouseY := as.win.height - as.win.borderBottom - as.win.mouseY - 1
  71.   END
  72. END TickProc;
  73.  
  74. PROCEDURE Available* () : INTEGER;
  75. BEGIN
  76.   as.GetNextEvent;
  77.   RETURN n
  78. END Available;
  79.  
  80. PROCEDURE Read* ( VAR ch : CHAR );
  81. BEGIN
  82.   REPEAT as.GetNextEvent UNTIL n > 0;
  83.   DEC (n); ch := buf [out]; out := (out + 1) MOD N
  84. END Read;
  85.  
  86. PROCEDURE Mouse* ( VAR keys : SET; VAR x, y : INTEGER );
  87. BEGIN
  88.   as.GetNextEvent;
  89.   IF mouseX < 0 THEN mouseX := 0 END;
  90.   IF mouseX >= mouseW THEN mouseX := mouseW - 1 END;
  91.   IF mouseY < 0 THEN mouseY := 0 END;
  92.   IF mouseY >= mouseH THEN mouseY := mouseH - 1 END;
  93.   keys := mouseKeys; x := mouseX; y := mouseY
  94. END Mouse;
  95.  
  96. PROCEDURE SetMouseLimits* ( w, h : INTEGER );
  97. BEGIN
  98.   mouseW := w; mouseH := h
  99. END SetMouseLimits;
  100.  
  101. PROCEDURE Time* () : LONGINT;
  102. BEGIN RETURN 0
  103. END Time;
  104.  
  105. BEGIN
  106.   n := 0; in := 0; out := 0;
  107.   mouseW := as.W; mouseH := as.H;
  108.   as.KeyProc := KeyProc;
  109.   as.MouseProc := MouseProc;
  110.   as.TickProc := TickProc
  111. END InputPO.
  112.